HPAVC/HPAVC CD-ROM.iso/PRUS101.ZIP/FCONDRV.INC

Text File | 1994-12-20 | 13KB | 515 lines

{ FCONDRV.INC - include file to partially clone CRT's functions for usage by
                the PRUSSG unit FCRT
  ***************************************************************************

         RELEASE 1.08 - as first contained in the file PRUS101.LZH
                 by Paul Schubert, 2:244/1181.18,  GERMANY

               --------------------------------------------
                organized for Fido's PASCAL related echoes
               --------------------------------------------

    06/21/1994 to --/--/---- by Paul Schubert, 2:244/1181.18,  GERMANY


           As far as third party copyrights are not violated this
           source code is hereby placed to the public domain. Use
           it whatever way you want, but use AT YOUR OWN RISK.

           In case you should modify the source rather send your
           modifications to the unit's current organizer (see above for
           NM address) than to spread it on your own. This will help to
           keep the unit updated and grant a certain standard to all
           other users as well.

           The unit is currently still under work. So it might greatly
           benefit of your participation.

           Those who contributed to the following piece of source,
           listed in alphabethical order:
        ================================================================
           Orazio Czerwenka, Paul Schubert ...
        ================================================================
           YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.

           Credits in your own programs are as welcome as unnecessary.

 ***************************************************************************}

TYPE  CPOSTYPE      = RECORD X,Y : BYTE END;
      WORDARRAY     = ARRAY[0..$FFF] OF WORD;
      PWORDARRAY    = ^WORDARRAY;
      SOF           = RECORD O,S : WORD END;
      WINDOWPTR     = ^WINDOWTYP;
      WINDOWTYP     = RECORD
        NXT      : WINDOWPTR;
        X,Y,W,H  : BYTE;
        DATEN    : ARRAY[0..0] OF BYTE;
      END;
      CURSORTYPE    = ARRAY[0..7] OF CPOSTYPE;


CONST WINDPTR           : WINDOWPTR = NIL;


VAR
      CURSOR            : CURSORTYPE ABSOLUTE $40:$50;

      LINEWIDTH         : WORD;
      WINDWIDTH         : BYTE;
      WINDHEIGHT        : BYTE;

      WMI,WMA           : ARRAY[0..7] OF WORD;


PROCEDURE STI;   INLINE($FB);
PROCEDURE CLI;   INLINE($FA);
PROCEDURE PUSHF; INLINE($9C);
PROCEDURE POPF;  INLINE($9D);


PROCEDURE SETPORT(PORTADR:WORD;INDEX,DAT:BYTE);
BEGIN
  PUSHF;
  CLI;
  PORT[PORTADR] := INDEX;
  PORT[PORTADR+1] := DAT;
  POPF;
END;


FUNCTION CURSORPOINTER:POINTER;
BEGIN
  CURSORPOINTER := PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE
                       +(WORD(MaxX)*CURSOR[ACTIVEVIDEOPAGE].Y
                       +CURSOR[ACTIVEVIDEOPAGE].X) SHL 1);
END; { CURSORPOINTER }


FUNCTION SCREENPOINTER:POINTER;
BEGIN
  SCREENPOINTER := PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE);
END; { SCREENPOINTER }


FUNCTION WINDOWPOINTER:POINTER;
BEGIN
  WINDOWPOINTER := PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE
                       +LINEWIDTH*HI(WINDMIN)
                       +(LO(WINDMIN) SHL 1));
END; { WINDOWPOINTER }


PROCEDURE FILLWORD(START:PWORDARRAY;ANZAHL,DATEN:WORD);
ASSEMBLER;
ASM
  LES DI,START
  MOV CX,ANZAHL
  MOV AX,DATEN
  CLD
  REP STOSW
END; { FILLWORD }
{
FCRT.FILLWORD: ASM
  cs:00B8 55             push   bp
  cs:00B9 89E5           mov    bp,sp
FCRT.FCONDRV.INC.107:  LES DI,START
  cs:00BB C47E0A         les    di,[bp+0A]
FCRT.FCONDRV.INC.108:  MOV CX,ANZAHL
  cs:00BE 8B4E08         mov    cx,[bp+08]
FCRT.FCONDRV.INC.109:  MOV AX,DATEN
  cs:00C1 8B4606         mov    ax,[bp+06]
FCRT.FCONDRV.INC.110:  CLD
  cs:00C4 FC             cld
FCRT.FCONDRV.INC.111:  REP STOSW
  cs:00C5 F3AB           rep stosw
FCRT.FCONDRV.INC.112: END;
  cs:00C7 C9             leave
  cs:00C8 CA0800         retf   0008
}

PROCEDURE SCROLL;
VAR   Y      : BYTE;
      P1,P2  : POINTER;
      R      : REGISTERS;
BEGIN
  IF DIRECTVIDEO THEN BEGIN
    P1  := WINDOWPOINTER;
    P2  := P1; INC(SOF(P2).O,LINEWIDTH);

    FOR Y := SUCC(HI(WINDMIN)) TO SUCC(HI(WINDMAX)) DO BEGIN
      MOVE(P2^,P1^,WINDWIDTH SHL 1);
      P1 := P2;
      INC(SOF(P2).O,LINEWIDTH);
    END; { NEXT Y }

    DEC(SOF(P1).O,LINEWIDTH);
    FILLWORD(P1,WINDWIDTH,WORD(TEXTATTR) SHL 8 + $20);
  END ELSE BEGIN
    R.AH := 5;
    R.AL := ACTIVEVIDEOPAGE;
    INTR($10,R);
    R.AX := $601;
    R.BH := TEXTATTR;
    R.CX := WINDMIN;
    R.DX := WINDMAX;
    INTR($10,R);
  END;
END; { SCROLL }


{
  SCROLLABSOLUTE WIRD NIRGENDS GEBRAUCHT
}
PROCEDURE SCROLLABSOLUTE;
VAR   R  : REGISTERS;
BEGIN
  IF DIRECTVIDEO THEN BEGIN
    MOVE(MEM[VIDEORAM:VideoPageSize*ACTIVEVIDEOPAGE+LINEWIDTH],
         SCREENPOINTER^,
         LINEWIDTH*MaxY);
    FILLWORD(PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE+
             MaxY*LINEWIDTH),
             MaxX,
             WORD(TEXTATTR) SHL 8 + $20);
  END ELSE BEGIN
    R.AH := 5;
    R.AL := ACTIVEVIDEOPAGE;
    INTR($10,R);
    R.AX := $601;
    R.BH := TEXTATTR;
    R.CX := 0;
    R.DH := SUCC(MaxY);
    R.DL := MaxX;
    INTR($10,R);
  END;
END; { SCROLLABSOLUTE }


PROCEDURE WINDOW(x,y,xx,yy:BYTE);
BEGIN
  IF (WHEREX < x) OR (WHEREY < y) OR (WHEREX > xx) OR (WHEREY > yy)
    THEN GOTOXYABSOLUTE(x,y);
  WINDMIN := PRED(y)  SHL 8 + PRED(x);
  WINDMAX := PRED(yy) SHL 8 + PRED(xx);
  WMI[ACTIVEVIDEOPAGE] := WINDMIN;
  WMA[ACTIVEVIDEOPAGE] := WINDMAX;
  WINDWIDTH  := SUCC(xx-x);
  WINDHEIGHT := SUCC(yy-y);
END; { WINDOW }


PROCEDURE PUSHWINDOW;
VAR   YY,WID     : WORD;
      OLDP       : WINDOWPTR;
      DATP,VIDP  : POINTER;
BEGIN
  OLDP := WINDPTR;
  WID  := WINDWIDTH SHL 1;

  GETMEM(WINDPTR,WID*WINDHEIGHT+SIZEOF(WINDOWTYP));

  WITH WINDPTR^ DO BEGIN
    NXT := OLDP;
    X := LO(WINDMIN);
    Y := HI(WINDMIN);
    W := WID;
    H := WINDHEIGHT;
    DATP := @WINDPTR^.DATEN;
    VIDP := WINDOWPOINTER;
    FOR YY := Y TO PRED(Y+H) DO BEGIN
      MOVE(VIDP^,DATP^,W);
      INC(SOF(DATP).O,W);
      INC(SOF(VIDP).O,LINEWIDTH);
    END; { NEXT Y }
  END; { WITH }
END; { PUSHWINDOW }


PROCEDURE POPWINDOW;
VAR   YY        : WORD;
      OLDP      : WINDOWPTR;
      DATP,VIDP : POINTER;
BEGIN
  IF WINDPTR = NIL THEN EXIT;

  WITH WINDPTR^ DO BEGIN
    OLDP := NXT;
    DATP := @WINDPTR^.DATEN;
    VIDP := PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE+(Y * MaxX + X) SHL 1);
    FOR YY := Y TO PRED(Y+H) DO BEGIN
      MOVE(DATP^,VIDP^,W);
      INC(SOF(DATP).O,W);
      INC(SOF(VIDP).O,LINEWIDTH);
    END; { NEXT Y }
    FREEMEM(WINDPTR,W*H+SIZEOF(WINDOWTYP));
  END; { WITH }
  WINDPTR := OLDP;
END; { POPWINDOW }


PROCEDURE MOVECURSOR;
VAR   I  : WORD;
BEGIN
  I := VideoPageSize * ACTIVEVIDEOPAGE +
       WORD(MaxX)*CURSOR[ACTIVEVIDEOPAGE].Y+
       CURSOR[ACTIVEVIDEOPAGE].X;
  SETPORT(CRTC,$E,HI(I));
  SETPORT(CRTC,$F,I);
END; { MOVECURSOR }


PROCEDURE GOTOXYABSOLUTE(X,Y:BYTE);
BEGIN
  CURSOR[ACTIVEVIDEOPAGE].X := PRED(X);
  CURSOR[ACTIVEVIDEOPAGE].Y := PRED(Y);
  MOVECURSOR;
END; { GOTOXYABSOLUTE }


PROCEDURE GOTOXY(X,Y:BYTE);
BEGIN
  CURSOR[ACTIVEVIDEOPAGE].X := PRED(X)+LO(WINDMIN);
  CURSOR[ACTIVEVIDEOPAGE].Y := PRED(Y)+HI(WINDMIN);
  MOVECURSOR;
END; { GOTOXY }


PROCEDURE CLRSCRABSOLUTE;
VAR   R  : REGISTERS;
BEGIN
  IF DIRECTVIDEO THEN BEGIN
    GOTOXYABSOLUTE(1,1);
    FILLWORD(SCREENPOINTER,VideoPageSize SHR 1,
             WORD(TEXTATTR) SHL 8 + $20);
  END ELSE BEGIN
    R.AH := 5;
    R.AL := ACTIVEVIDEOPAGE;
    INTR($10,R);
    R.AX := $600;
    R.BH := TEXTATTR;
    R.CX := 0;
    R.DH := SUCC(MaxY);
    R.DL := MaxX;
    INTR($10,R);
  END;
END; { CLRSCRABSOLUTE }


PROCEDURE CLRSCR;
VAR   Y,AW  : WORD;
      P1    : POINTER;
VAR   R     : REGISTERS;
BEGIN
  GOTOXY(1,1);
  IF DIRECTVIDEO THEN BEGIN
    P1  := WINDOWPOINTER;
    AW  := WORD(TEXTATTR) SHL 8 + $20;
    FOR Y := HI(WINDMIN) TO HI(WINDMAX) DO BEGIN
      FILLWORD(P1,WINDWIDTH,AW);
      INC(SOF(P1).O,LINEWIDTH);
    END; { NEXT Y }
  END ELSE BEGIN
    R.AH := 5;
    R.AL := ACTIVEVIDEOPAGE;
    INTR($10,R);
    R.AX := $600;
    R.BH := TEXTATTR;
    R.CX := WINDMIN;
    R.DX := WINDMAX;
    INTR($10,R);
  END;
END; { CLRSCR }


PROCEDURE CLREOL;
VAR   R  : REGISTERS;
BEGIN
  IF DIRECTVIDEO THEN BEGIN
    FILLWORD(CURSORPOINTER,
             LO(WINDMAX)-WHEREXABSOLUTE + 2,
             WORD(TEXTATTR) SHL 8 + $20
            );
  END ELSE BEGIN
    R.AX := $920;
    R.BH := ACTIVEVIDEOPAGE;
    R.BL := TEXTATTR;
    R.CX := LO(WINDMAX)-WHEREXABSOLUTE + 2;
    INTR($10,R);
  END;
END; { CLREOL }


PROCEDURE CLREOS;
VAR   Y,AW  : WORD;
      P1    : POINTER;
      R     : REGISTERS;
BEGIN
  P1  := PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE
                      +WHEREYABSOLUTE*LINEWIDTH + LO(WINDMIN) SHL 1);
  AW  := WORD(TEXTATTR) SHL 8 + $20;
  CLREOL;
  IF DIRECTVIDEO THEN BEGIN
    FOR Y := WHEREYABSOLUTE TO HI(WINDMAX) DO BEGIN
      FILLWORD(P1,WINDWIDTH,AW);
      INC(SOF(P1).O,LINEWIDTH);
    END; { NEXT Y }
  END ELSE BEGIN
    Y := WHEREYABSOLUTE;
    IF Y < HI(WINDMAX) THEN BEGIN
      R.AH := 5;
      R.AL := ACTIVEVIDEOPAGE;
      INTR($10,R);
      R.AH := $6;
      R.AL := Hi (WindMax) - y + 1;
      R.BH := TEXTATTR;
      R.CH := Y;
      R.CL := LO(WINDMIN);
      R.DX := WINDMAX;
      INTR($10,R);
    END;
  END;
END; { CLREOS }


FUNCTION  WHEREXABSOLUTE:BYTE;
BEGIN
  WHEREXABSOLUTE := SUCC(CURSOR[ACTIVEVIDEOPAGE].X);
END; { WHEREXABSOLUTE }


FUNCTION  WHEREYABSOLUTE:BYTE;
BEGIN
  WHEREYABSOLUTE := SUCC(CURSOR[ACTIVEVIDEOPAGE].Y);
END; { WHEREYABSOLUTE }


FUNCTION  WHEREX:BYTE;
BEGIN
  WHEREX := SUCC(CURSOR[ACTIVEVIDEOPAGE].X)-LO(WINDMIN);
END; { WHEREX }


FUNCTION  WHEREY:BYTE;
BEGIN
  WHEREY := SUCC(CURSOR[ACTIVEVIDEOPAGE].Y)-HI(WINDMIN);
END; { WHEREY }


FUNCTION COUT(VAR F:TEXTREC):WORD;
VAR   I,CW  : WORD;
      CP    : CPOSTYPE;
      WPTR  : ^WORD;
      CPTR  : ^BYTE;
      R     : REGISTERS;

PROCEDURE LINEFEED;
BEGIN
  IF CP.Y < HI(WINDMAX) THEN BEGIN
    INC(CP.Y);
  END ELSE BEGIN
    SCROLL;
  END;
  CURSOR[ACTIVEVIDEOPAGE] := CP;
  WPTR := CURSORPOINTER;
END; { LINEFEED }

BEGIN { COUT }
  WITH F DO BEGIN
    IF BUFPOS > 0 THEN BEGIN
      CP   := CURSOR[ACTIVEVIDEOPAGE];
      WPTR := CURSORPOINTER;
      CPTR := POINTER(BUFPTR);
      CW   := WORD(TEXTATTR) SHL 8;
{---
  this is the lowest level output routine :
  BUFPTR^ contains BUFPOS chars for output
}
      FOR I := 0 TO PRED(BUFPOS) DO BEGIN
        CASE BUFPTR^[I] OF
          ^G : BEGIN { DAS SOLL PIEPSEN }
                 R.AX := $E07;
                 INTR($10,R);
               END;
          ^M : BEGIN
                 CP.X := LO(WINDMIN);
                 WPTR := CURSORPOINTER;
               END;
          ^J : LINEFEED;
        ELSE
          IF DIRECTVIDEO THEN BEGIN
            WPTR^ := CW OR CPTR^;
            INC(SOF(WPTR).O,2);
          END ELSE BEGIN
            R.AH := 9;
            R.AL := CPTR^;
            R.BH := ACTIVEVIDEOPAGE;
            R.BL := TEXTATTR;
            R.CX := 1;
            INTR($10,R);
          END;
          INC(SOF(CPTR).O);

          IF CP.X < (LO(WINDMAX)) THEN BEGIN
            INC(CP.X);
          END ELSE BEGIN
            CP.X := LO(WINDMIN);
            LINEFEED;
          END;
          IF NOT DIRECTVIDEO THEN CURSOR[ACTIVEVIDEOPAGE] := CP;
        END; { CASE }
      END; { NEXT I }
{---}
      BUFPOS := 0;
      CURSOR[ACTIVEVIDEOPAGE] := CP;
      MOVECURSOR;
    END; { IF BUFPOS > 0 }
  END; { WITH F }
  COUT := 0;
END; { COUT }


FUNCTION COPEN(VAR F:TEXTREC):WORD;
BEGIN
  F.MODE := FMOUTPUT;
  COPEN := 0;
END; { COPEN }


FUNCTION CCLOSE(VAR F:TEXTREC):WORD;
BEGIN
  F.MODE := FMCLOSED;
  CCLOSE := 0;
END; { CCLOSE }


PROCEDURE ASSIGNFCRT(VAR F:TEXT);
BEGIN
  WITH TEXTREC(F) DO BEGIN
    MODE := FMCLOSED;
    OPENFUNC  := @COPEN;
    FLUSHFUNC := @COUT;
    CLOSEFUNC := @CCLOSE;
    INOUTFUNC := @COUT;
    BUFEND    := 0;
    BUFPOS    := 0;
    BUFPTR    := @BUFFER;
    NAME[0]   := #0;
  END;
END; { ASSIGNFCRT }


PROCEDURE REINITFCONDRV;
BEGIN
  CRTC          := MEMW[$40:$63];
  LINEWIDTH     := MaxX SHL 1;
  WINDMAX       := WORD(PRED(MaxY)) SHL 8 + PRED(MaxX);
  WINDMIN       := 0;
  WINDWIDTH  := SUCC(WindMax AND $FF);
  WINDHEIGHT := SUCC((WindMax SHR 8) AND $FF);
  FILLWORD(@WMI,8,WINDMIN);
  FILLWORD(@WMA,8,WINDMAX);

END; { REINITCRT }